#!/usr/bin/perl

# Copyright © 2014 Jakub Wilk <jwilk@jwilk.net>
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the “Software”), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

use v5.10;

use strict;
use warnings;

no lib '.';

use English qw(-no_match_vars);
use FindBin ();

use IO::Socket::SSL;

chdir("$FindBin::Bin/..")
    or die $ERRNO;

my %hosts = (
    'online.mbank.pl' => 'ca.crt',
    'www.howsmyssl.com' => 't/howsmyssl-ca.crt',
);

my $rc = 0;
while (my ($host, $file) = each %hosts) {
    print {*STDERR} "$host ... ";
    my $pem = undef;
    my $callback = sub {
        my ($ok, undef, undef, undef, $cert) = @_;
        $pem //= Net::SSLeay::PEM_get_string_X509($cert);
        $pem //= '';
        return $ok;
    };
    eval {
        IO::Socket::SSL->new(
            PeerHost => $host,
            PeerPort => 'https',
            SSL_verify_mode => SSL_VERIFY_PEER,
            SSL_verifycn_scheme => 'http',
            SSL_verify_callback => $callback,
        ) or die $IO::Socket::SSL::SSL_ERROR;
        $pem
            or die 'unable to determine CA';
        open(my $fh, '>', "$file.new")
            or die $ERRNO;
        print {$fh} $pem;
        close($fh)
            or die $ERRNO;
        rename("$file.new", $file)
            or die $ERRNO;
    } or do {
        my $error = "$EVAL_ERROR";
        my $cruft = 'IO::Socket::IP configuration failed SSL connect attempt failed with unknown error';
        $error =~s /\A\Q$cruft error/error/;
        $error =~ s/\n+\z//;
        print {*STDERR} "FAIL: $error\n";
        $rc = 1;
        next;
    };
    print {*STDERR} "ok\n";
}
exit($rc);

# vim:ts=4 sts=4 sw=4 et
